perm filename OCCULT[GEM,BGB]3 blob
sn#057507 filedate 1973-08-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00031 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE OCCULT - A HIDDEN LINE ELIMINATOR - FEBRUARY 1973.
C00006 00003 SUBR(OCCULT,WRLD) A HIDDEN LINE ELIMINATOR.
C00009 00004 SUBR(XYSORT,SPTR)----------------------------------------------
C00011 00005 ...XYSORT
C00013 00006 ...XYSORT
C00016 00007 SUBR(CLIP)-----------------------------------------------------
C00019 00008 REPACK:
C00021 00009 SUBR(VSCAN)
C00023 00010 SUBR(VSOLVE,VERTEX)
C00026 00011 SUBR(ESCAN,S0)
C00028 00012 SUBR(MKTJ,FOLD0,EDGE0) MAKE A T-JOINT.
C00031 00013 SUBR(EHIDE,FACE,EDGE,VERTEX) EDGE HIDE.
C00034 00014 SUBR(VHIDE,FACE,VERTEX) VERTEX HIDE.
C00036 00015 SUBR(COMPEE,EDG1,EDG2) COMPARE EDGE-EDGE.
C00039 00016 COMPARE E1 AND U1.
C00042 00017 SUBR(FUDGE,VERTEX,EDGE)
C00044 00018 SUBR(EBREAK,EDGE) EBREAK(EDGE) IS LIKE ESPLIT.
C00047 00019 SUBR(TJSCAN) SCAN TJ LIST & PROMULAGATE UNDER FACES.
C00050 00020 SUBR(EPROP,UF,EDGE,VERTEX) PROPAGATE UNDER FACE ALONG THE FOLDS.
C00054 00021 SUBR(VPROP,FACE,VERTEX)
C00056 00022 SUBR(SHOW) PROPAGATE VISIBLE EDGES.
C00059 00023 SUBR(VSHOW,VERTEX)
C00062 00024 SUBR(FSCAN,VERTEX) FACE SCAN FOR UNDERFACE OF V AND SKIP.
C00064 00025 SUBR(QEV,EDGE,VERTEX) DISTANCE VERTEX TO EDGE.
C00069 00026 SUBR(ZDEPTH,FACE,VERTEX) ZPP DEPTH.
C00072 00027 SUBR(KLJOTS,WORLD)
C00075 00028 EXTERN IDPY,EDPY,VDPY
C00078 00029
C00080 00030 SUBR(WINDPY,S00) WINDOW DISPLAY.
C00082 00031 SUBR(STAT) DISPLAY OCCULT STATISTICS.
C00084 ENDMK
C⊗;
TITLE OCCULT - A HIDDEN LINE ELIMINATOR - FEBRUARY 1973.
;OCCULT IS DEPENDENT ON THE WING AND EULER PRIMITIVES.
EXTERN MKB,MKF,MKE,MKV
EXTERN KLB,KLF,KLE,KLV
EXTERN WING,LINKED
EXTERN ECW,ECCW,OTHER
EXTERN BGET,FCW,FCCW,VCW,VCCW
EXTERN MKEV,MKFE,ESPLIT,KLEV,KLFE
;LINK NAMES RELEVANT ONLY TO OCCULT.
PVEL: 0 ;POTENTIALLY VISIBLE EDGE LIST.
AVEL: 0 ; ACTUALLY VISIBLE EDGE LIST.
TJLIST: 0 ;TJOINT LIST.
BGND: 0 ;BACK GROUND "FACE" POINTER.
LEFT(NEDR,6)↔ RIGHT(PEDR,6) ;EDGE RINGS.
RIGHT(TJ,7) ;TJ LIST LINK.
DEFINE TJOINT(Q,V)<CAR Q,2(V)> ;TJOINT POINTER.
DEFINE TJOIN.(Q,V)<DIP Q,2(V)>
;DIAGNOSTICS & CONTROL FLAGS.
HVFLAG: 0 ;ENABLE PREVIOUSLY HIDDEN VERTEX HIDE.
DECLARE{TIME1,TIME2}
WORLD:0
DMODE↑:0 ;DIAGNOSTIC MODE.
ELIMIT: =12 ;EDGES PER WINDOW THRESHOLD.
PDLTOP:0 ;MAXIMUM DEPTH OF DEEP PDL.
DEEPDL:BLOCK =1024
WNDCNT:0 ;NUMBER OF XY-SORT WINDOWS.
COMCNT:0 ;NUMBER OF EDGE-EDGE COMPARES.
;OUTER MOST WINDOW FROM VSCAN.
DECLARE{XPPMIN,XPPMAX,YPPMIN,YPPMAX}
DECLARE{VXMIN,VXMAX,VYMIN,VYMAX}
SUBR(OCCULT,WRLD) ;A HIDDEN LINE ELIMINATOR.
COMMENT ⊗------------------------------------------------------------
⊗
;INITIALIZE THE EDGE LISTS.
DZM AVEL ;NO ACTUALLY VISIBILE EDGES YET.
LAC 1,WRLD↔DAC 1,WORLD ;SAVE THE WORLD ARGUMENT.
PED 1,1↔DAC 1,PVEL ;FIRST EDGE.
JUMPE 1,POP1J.↔ZIP 6(1) ;EXIT WHEN THERE ARE NO EDGES.
L0: PEDR 2,1↔JUMPE 2,L1↔NEDR. 1,2 ;MAKE THE BACK LINKS.
PEDR 1,2↔JUMPE 1,L1↔NEDR. 2,1↔GO L0
;READ CLOCKS.
L1: SETZ↔MSTIME↔DAC TIME1 ;REAL TIME.
SETZ↔RUNTIM↔DAC TIME2 ;RUN TIME.
;TRY TO HIDE VERTICES THAT WERE HIDDEN BEFORE.
DZM TJLIST ;TJOINT LIST ← NIL.
DZM COMCNT ;EDGE-EDGE COMPARES COUNT.
DZM WNDCNT ;WINDOW COUNT.
CALL(VSCAN) ;TRY TO HIDE VERTICES PREVIOUSLY HIDDEN.
;PLACE OUTERMOST WINDOW INTO THE DEEP PDL.
DZM PDLTOP ;MAXIMUM PDL DEPTH USED.
LACI 1,DEEPDL
DZM(1) ;WINDOW CUT DIRECTION (HORIZONTAL).
LAC 2,PVEL ;WINDOW'S LAST POTENT EDGE.
PUSH 1,2
PUSH 1,[1] ;CURRENT EDGE COUNT.
PUSH 1,XPPMIN ;OUTER MOST WINDOW.
PUSH 1,XPPMAX
PUSH 1,YPPMIN
PUSH 1,YPPMAX
PUSH 1,2 ;ONLY EDGE IN WINDOW.
ZIP 1
;DO THIS WINDOW AND ALL ITS DESCENDANTS.
CALL(XYSORT,1) ;CALLS ON EHIDE & VHIDE TO MARK HIDDEN EDGES.
CALL(TJSCAN) ;T-JOINT SCAN TO PROPAGATE UNDERFACES.
CALL(SHOW) ;CALLS ON VSHOW - TO MARK VISIBLE EDGES.
CALL(STAT) ;DISPLAY DIAGNOSTIC STATISTICS.
POP1J
ENDR OCCULT;2/25/73(BGB)---------------------------------------------
SUBR(XYSORT,SPTR)----------------------------------------------
; DO WINDOW OR SPLIT IT IN TWO - BGB 25 FEB 1973.
ACCUMULATORS{S0,S1,S2,E,A}
;WINDOW DEEP STACK BLOCK FORMAT.
CUTFLG ←← -7 ;CUT DIRECTION SWITCH. 0 IN X. -1 IN Y.
ELAST ←← -6 ;LAST POTENT EDGE.
EDGCNT ←← -5 ;EDGE COUNT
XLO ←← -4 ;XL
XHI ←← -3 ;XH
YLO ←← -2 ;YL
YHI ←← -1 ;YH
;PUSH LATE BORN EDGES INTO THE CURRENT WINDOW.
LAC S0,SPTR ;WINDOW POINTER.
LAC 1,EDGCNT(S0) ;EDGE COUNT.
DIP 1,1 ;XWD ECNT,,ECNT
ADDI 1,-1(S0) ;XWD ECNT,,S0+ECNT-1 DEEP PDL PTR.
LAC E,ELAST(S0) ;LAST POTENT EDGE.
L1: LAC A,E↔POTEN E,E
JUMPE E,L2
TESTZ E,POTENT↔PUSH 1,E
GO L1
L2: HLRZM 1,EDGCNT(S0) ;UPDATE EDGE COUNT.
DAC A,ELAST(S0) ;UPDATE LAST POTENT EDGE.
ANDI 1,377777↔SUBI 1,DEEPDL
CAMLE 1,PDLTOP↔DAC 1,PDLTOP ;MAXIMUM PDL DEPTH.
;WINDOW ZERO POINTERS AND SIZE.
LAC S0,ARG1↔DAC S0,BEG0 ;BEGINNING.
LAC EDGCNT(S0)↔DAC SIZ0 ;SIZE.
LACN↔SLAC↔LAP S0↔DAC P0 ;PDL POINTER.
LAC BEG0↔ADD SIZ0↔SOS↔DAC END0 ;END.
;TEST FOR SMALL ENUF WINDOW POPULATION.
LAC SIZ0↔CAMGE ELIMIT ;THRESHOLD EDGE COUNT.
;EASY WINDOW - DO HIDDEN LINE ELIMINATON & EXIT.
GO[CALL(ESCAN,BEG0)↔POP1J]
;HARD WINDOW - FALL THRU & SPLIT THE WINDOW.
;...XYSORT
;COPY POTENT RIGHT HALVES TO LEFT.
LAC S0,P0
L3: LAC E,(S0)
TEST E,POTENT↔TDCA E,E
DIP E,E↔DAC E,(S0)
AOBJN S0,L3
;CLIP EDGES INTO FIRST WINDOW.
XL←←13 ↔ XH←←14 ↔ YL←←15 ↔ YH←←16
L4: LAC S0,BEG0↔SLACI XLO(S0)↔LAPI XL↔BLT YH ;GET WINDOW 0.
LAC XH↔FSB XL↔CAMGE[1.0]↔POP1J
LAC YH↔FSB YL↔CAMGE[1.0]↔POP1J
LACM 1,CUTFLG(S0)↔ASH 1,1
LAC XL(1)↔FAD XH(1)
FSC -1↔DAC MID#
SKIPE CUTFLG(S0)
SKIPA YH,MID
LAC XH,MID ;MAKE WINDOW 1.
LAC[XWD XL,W1]↔BLT W1+3 ;SAVE WINDOW 1.
LAC 1,P0↔SETZ ;CLEAR INSIDER COUNT.
CAR 2,(1)↔CALL(CLIP)
ZIP(1)↔AOBJN 1,.-3
DAC SIZ1
;CLIP EDGES INTO SECOND WINDOW.
L5: LAC S0,BEG0
SLACI XLO(S0)
LAPI XL↔BLT YH ;GET WINDOW 0.
SKIPE CUTFLG(S0)
SKIPA YL,MID
LAC XL,MID ;MAKE WINDOW 2.
LAC 1,P0↔SETZ ;INSIDER EDGE COUNT.
CDR 2,(1)↔CALL(CLIP) ;LOOP EDGES,
ZAP(1)↔AOBJN 1,.-3 ;THRU CLIP.
;...XYSORT
;TEST FOR EMPTY WINDOWS.
L5A: DAC SIZ2↔ADD SIZ1
SKIPN↔POP1J ;BOTH WINDOWS EMPTY.
SKIPE SIZ1↔GO L5B ;WINDOW 1 EMPTY.
LAC S0,BEG0↔LAC MID↔SKIPE CUTFLG(S0)↔ADDI S0,2
DAC XLO(S0)↔LAC 1,P0↔HRLS(1)↔AOBJN 1,.-1
SETCMM CUTFLG(S0)↔GO L4
L5B:
SKIPE SIZ2↔GO L6 ;WINDOW 2 EMPTY.
LAC S0,BEG0↔LAC MID↔SKIPE CUTFLG(S0)↔ADDI S0,2
DAC XHI(S0)↔LAC 1,P0↔HLRS(1)↔AOBJN 1,.-1
SETCMM CUTFLG(S0)↔GO L4
;SETUP WINDOW POINTERS.
L6: LAC BEG0↔DAC BEG2
ADD SIZ2↔SOS↔DAC END2
ADDI 8↔DAC BEG1
ADD SIZ1↔SOS↔DAC END1
LACN SIZ2↔HRL BEG2↔MOVSM P2 ;AOBJN POINTER 2.
LACN SIZ1↔HRL BEG1↔MOVSM P1 ;AOBJN POINTER 1.
CALL(REPACK)
LAC S1,BEG1
LAC S2,BEG2
;SETUP WINDOW HEADER DATA.
L7: LAC ELAST(S2)↔DAC ELAST(S1) ;LAST POTENT EDGE.
SLACI XL↔LAPI XLO(S2)↔BLT YHI(S2) ;WINDOWS.
SLACI W1↔LAPI XLO(S1)↔BLT YHI(S1)
LAC SIZ1↔DAC EDGCNT(S1) ;WINDOW EDGE COUNTS.
LAC SIZ2↔DAC EDGCNT(S2)
SETCMB CUTFLG(S2)↔DAC CUTFLG(S1) ;CUT DIRECTION SWITCH.
;TWO CALLS ON XYSORT.
DAC S2,ARG1 ;CONVERT CURRENT EXECUTION TO SECOND.
CALL(XYSORT,S1) ;FIRST CALL.
JCALL XYSORT ;SECOND CALL.
;DATA GLOBAL TO CLIP AND REPACK.
DECLARE{BEG0,END0,SIZ0,P0}
DECLARE{BEG1,END1,SIZ1,P1}
DECLARE{BEG2,END2,SIZ2,P2}
W1:0↔0↔0↔0 ;WINDOW 1 SAVE AREA.
;2/25/73(BGB)_______________________________________________________
SUBR(CLIP)-----------------------------------------------------
; CLIP DETECTOR - SKIP WHEN EDGE CROSSES WINDOW.
;ARGUMENTS EXPECTED TO BE IN ACCUMULATORS XL,XH,YL,YH & 2.
ACCUMULATORS{C0,C1,C2,X0,X1,X2,Y0,Y1,Y2,XL,XH,YL,YH}
SKIPN 2↔POP0J
PVT C1,2↔LAC X1,XPP(C1)↔LAC Y1,YPP(C1)
NVT C2,2↔LAC X2,XPP(C2)↔LAC Y2,YPP(C2)
SETZB C1,C2
CAML Y1,YH↔IORI C1,8 ;NORTH.
CAMG Y1,YL↔IORI C1,4 ;SOUTH.
CAML X1,XH↔IORI C1,2 ;EAST.
CAMG X1,XL↔IORI C1,1 ;WEST.
JUMPE C1,HIT
CAML Y2,YH↔IORI C2,8 ;NORTH.
CAMG Y2,YL↔IORI C2,4 ;SOUTH.
CAML X2,XH↔IORI C2,2 ;EAST.
CAMG X2,XL↔IORI C2,1 ;WEST.
JUMPE C2,HIT
TDNE C1,C2 ;WHEN V1 & V2 ARE BEYOND THE WINDOW
POP0J ;IN THE SAME DIRECTION - EASY OUTSIDE.
L: LAC X0,X1↔FSB X0,X2↔MOVMS↔CAMGE X0,[1.0]↔GO[
LAC Y0,Y1↔FSB Y0,Y2↔MOVMS↔CAMGE Y0,[1.0]↔GO HIT↔GO .+1]
LAC X0,X1↔FAD X0,X2↔FSC X0,-1 ;MIDPOINT.
LAC Y0,Y1↔FAD Y0,Y2↔FSC Y0,-1
SETZ C0,
CAML Y0,YH↔IORI C0,8 ;NORTH.
CAMG Y0,YL↔IORI C0,4 ;SOUTH.
CAML X0,XH↔IORI C0,2 ;EAST.
CAMG X0,XL↔IORI C0,1 ;WEST.
JUMPE C0,HIT
TDNE C0,C1
GO .+5 ;FIRST HALF EASY OUT.
LAC C2,C0 ;FIRST HALF STILL IN DOUBT.
LAC X2,X0
LAC Y2,Y0↔GO L
TDNE C0,C2
POP0J ;BOTH HALVES EASY OUTSIDE.
LAC C1,C0 ;SECOND HALF STILL IN DOUBT.
LAC X1,X0
LAC Y1,Y0↔GO L
HIT: AOS↔AOS(P)↔POP0J
ENDR;2/25/73(BGB)-------------------------------------------------
REPACK:
BEGIN REPACK;--------------------------------------------------------
ACCUMULATORS{LO,HI}
;PACK RIGHT HALFWORDS DOWNWARDS FORMING WINDOW 2.
LAC LO,BEG0↔LAC HI,END0
L1: CAML LO,HI↔GO L2
CDR(LO)↔SKIPE↔AOJA LO,L1 ;SCAN FOR HOLE.
CDR(HI)↔SKIPN↔SOJA HI,.-2 ;SCAN FOR EDGE.
DAP(LO)↔SOS HI↔AOJA LO,L1 ;PUT EDGE IN HOLE.
;PACK LEFT HALFWORDS DOWNWARDS FORMING WINDOW 1.
L2: LAC LO,BEG0↔LAC HI,END0
L3: CAML LO,HI↔GO L4
CAR(LO)↔SKIPE↔AOJA LO,L3 ;SCAN FOR HOLE.
CAR(HI)↔SKIPN↔SOJA HI,.-2 ;SCAN FOR EDGE.
DIP(LO)↔SOS HI↔AOJA LO,L3 ;PUT EDGE IN HOLE.
;CLEAR LEFT HALVES OF THE WINDOWS.
L4: LAC HI,END1↔LAC 1,SIZ1 ;COPY WINDOW 1 UP.
LAC LO,BEG0↔ADDI LO,-1(1)
L5: CAR(LO)↔DAPZ(HI)
SOS LO↔SOS HI↔SOJG 1,L5
LAC 1,P2↔ZIP(1)↔AOBJN 1,.-1
POP0J
BEND;2/25/73(BGB)
ENDR XYSORT;2/25/73(BGB)---------------------------------------------
SUBR(VSCAN)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,F,V,X,Y,Q}
;INITIALIZE EXTREMA FOR OUTERMOST WINDOW.
SLACI 400000↔DAC XPPMAX↔DAC YPPMAX
SETCM↔DAC XPPMIN↔DAC YPPMIN
DZM EOWPTR ;WINDOW DOESN'T EXIST YET.
SKIPA B,WORLD ;FOR ALL THE BODIES OF THE WORLD.
L1: LAC B,BODY↔CCW B,B↔CAMN B,WORLD↔POP0J
DAC B,BODY↔LAC V,B ;FOR ALL THE VERTICES OF EACH BODY.
L2: PVT V,V↔CAMN V,BODY↔GO L1
TEST V,POTENT↔GO L2
;COLLECT EXTREMA.
LAC X,XPP(V)↔CAMGE X,XPPMIN↔GO[
DAC X,XPPMIN↔DAC V,VXMIN↔GO .+1]
LAC Y,YPP(V)↔CAMGE Y,YPPMIN↔GO[
DAC Y,YPPMIN↔DAC V,VYMIN↔GO .+1]
LAC X,XPP(V)↔CAMLE X,XPPMAX↔GO[
DAC X,XPPMAX↔DAC V,VXMAX↔GO .+1]
LAC Y,YPP(V)↔CAMLE Y,YPPMAX↔GO[
DAC Y,YPPMAX↔DAC V,VYMAX↔GO .+1]
PUSHP V↔CALL(VSOLVE,V)↔POPP V
;TRY TO HIDE THE VERTEX UNDER THE FACE THAT HIDE IT LAST TIME.
UFACE F,V↔WAC↔UFACE. 0,V↔JUMPE F,L2 ;PREVIOUS UBER FACE.
SKIPN HVFLAG↔GO L2 ;HIDE VERTEX ENABLED ?
TEST F,POTENT↔GO L2
DAC V,VERTEX↔DAC F,FACE
CALL(WITHIN,FACE,VERTEX)↔GO L3
CALL(ZDEPTH,FACE,VERTEX)↔JUMPE L3
CALL(VHIDE,FACE,VERTEX)
L3: LAC V,VERTEX↔GO L2
DECLARE{BODY,FACE,VERTEX}
ENDR VSCAN;2/27/73(BGB)----------------------------------------------
SUBR(VSOLVE,VERTEX)
COMMENT ⊗------------------------------------------------------------
Inspect folded concave vertices for easy EHIDE's and for
immediate underfaces.
⊗↔ ACCUMULATORS{F,U,V,E,E0,S0,S1,S2,CNT}
;NEED FOUR OR MORE POTENT EDGES FOR V-SOLVING.
LAC V,VERTEX↔NIM CNT,-4↔PED 1,V↔DAC 1,E0
L00: TESTZ 1,POTENT↔AOJGE CNT,L0↔CALL(ECCW,1,V)↔CAME 1,E0↔GO L00↔POP1J
L0: LAC V,VERTEX↔DZM CNT ;COUNT OF THE NUMBER OF OPEN FOLDS.
TEST V,FOLDED↔POP1J
SKIPN DMODE↔GO L2-2↔CALL(VERIFY,[ASCII/VSOLV/],[1])↔LAC V,VERTEX
PED E,V↔DAC E,E0
L2: TEST E,POTENT↔GO L1
TESTZ ,FOLDED↔AOS CNT ;POTENTIALLY "OPEN" FOLD.
SETQ(U,{OTHER,E,V})
;FOR ALL THE FACES OF THE VERTEX NOT LINKED TO E.
LAC S2,E↔SETQ(S2,{ECCW,S2,V})
L4: LAC S1,S2↔SETQ(S2,{ECCW,S1,V}) ;ADVANCE SIDES TO NEXT FACE.
CAMN S2,E↔GO L1
SETQ(F,{FCCW,S1,V})
TEST F,POTENT↔GO L4 ;FACE IS POTENTIALLY VISIBLE.
;WHEN QFEV(F,S1,U) > 0
L5: LAC 1,CC(S1)
LAC BB(S1)↔FMPR YPP(U)↔FADR 1,0
LAC AA(S1)↔FMPR XPP(U)↔FADR 1,0
PFACE 0,S1↔CAME 0,F↔MOVNS 1↔JUMPLE 1,L4
;AND WHEN QFEV(F,S2,U) > 0
LAC 1,CC(S2)
LAC BB(S2)↔FMPR YPP(U)↔FADR 1,0
LAC AA(S2)↔FMPR XPP(U)↔FADR 1,0
PFACE 0,S2↔CAME 0,F↔MOVNS 1↔JUMPLE 1,L4
;TRY TO HIDE THE EDGE UNDER THE FACE.
L6: TESTZ E,FOLDED↔SOS CNT ;DECREMENT CNT FOR CLOSED FOLDS.
CALL(ZDEPTH,F,U)
JUMPN[CALL(EHIDE,F,E,V)↔GO L0] ;EARLY EDGE HIDE.
TEST E,FOLDED↔GO L4
UFACE 0,E↔JUMPLE 0,L7
DAC F,7(P)↔DAC 1,6(P)↔DAC 0,F ;SAVE F AND ITS ZDEPTH AT U.
CALL(ZDEPTH,F,U) ;GET ZDEPTH OF E'S PREVIOUS UNDERFACE.
CAMGE 1,6(P)↔EXCH F,7(P);SKIP IF PREVIOUS UFACE COVERS PRESENT.
L7: UFACE. F,E↔GO L4 ;FOUND A NEW UNDERFACE FOR E.
;RING'A'ROUND THE VERTEX.
L1: SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L2↔POP1J↔CAIE CNT,2↔SKIPN CNT↔POP1J↔POP1J
;FATAL({NUMBER OF OPEN FOLDS ≠ 0 AND ≠ 2})]↔POP1J
ENDR VSOLVE;7/31/73(BGB)---------------------------------------------
SUBR(ESCAN,S0)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{E1,E2}
;DIAGONOSTIC DISPLAY WINDOW FRAME.
AOS WNDCNT ;INCREMENT WINDOW COUNT.
SKIPN DMODE↔GO L0↔CALL(WINDPY,ARG1)
CALL({VERIFY+2},[ASCII/ESCAN/],[0])
;COMPARE EACH EDGE IN THE WINDOW WITH ALL THE OTHERS,
;WHEN TWO EDGES CROSS MAKE A TJOINT.
L0: LAC E1,S0↔DAC E1,EDG1 ;FIRST EDGE.
LAC -5(E1) ;EDGE COUNT.
CAIGE 2↔POP1J ;TAKES AT LEAST TWO.
ADD E1↔DAC EOWPTR ;END OF WINDOW + 1.
DZM@ ;PUT 0 AFTER THE WINDOW.
SOS EDG1
L1: AOS E1,EDG1↔DAC E1,EDG2
SKIPN E1,(E1)↔POP1J ;EXIT.
TEST E1,POTENT↔GO L1
L2: AOS E2,EDG2
SKIPN E2,(E2)↔GO L1
TEST E2,POTENT↔GO L2
;COMPARE EDGES.
CALL(COMPEE,@EDG1,@EDG2)
CAIE 1,441↔GO L2 ;NO INTERSECTION.
CALL(MKTJ,@EDG1,@EDG2) ;CROSSING - MAKE TJOINT.
GO L2
DECLARE{EDG1,EDG2}
ENDR;2/10/73------------------------------------------------------
;END OF WINDOW POINTER.
EOWPTR: 0
SUBR(MKTJ,FOLD0,EDGE0) ;MAKE A T-JOINT.
COMMENT . ⊗ MAKE T-JOINT MANDALA
This MKTJ called |
only by ESCAN, |
There is another FACE2 FOLD FACE1
"MKTJ" embedded |
in EHIDE, EDGE ⊗JOT EJUT
⊗-------------⊗-|------------⊗
V JUT|
|
⊗ .
LAC FOLD0↔DAC FOLD
LAC EDGE0↔DAC EDGE
SETQ(JOT,{EBREAK,FOLD}) ;MAKE 'EM.
SETQ(JUT,{EBREAK,EDGE})
;DISTINGUISH ZPP-OVER ≥ ZPP-UNDER.
LAC 1,JUT↔LAC 2,JOT ;GET 'EM.
TJOIN. 1,2↔TJOIN. 2,1 ;LINK 'EM.
LAC 0,ZPP(1)↔CAMG 0,ZPP(2)↔GO L1 ;COMPARE 'EM.
EXCH 1,2↔DAC 1,JUT↔DAC 2,JOT ;SWAP 'EM.
LAC EDGE↔EXCH FOLD↔DAC EDGE
L1: MARK 1,JUTBIT↔MARK 2,JOTBIT ;MARK 'EM.
;ORIENT EDGES WITH RESPECT TO FOLD FACES.
LAC 1,FOLD
PFACE 0,1↔DAC FACE1↔NFACE 0,1↔DAC FACE2
SLACI(POTENT)↔AND@FACE1↔AND@FACE2↔ANDCAM@JUT
SETQ(V,{OTHER,EDGE,JUT})
LAC 1,JUT↔PED 1,1↔DAC 1,EJUT
CALL(QFEV,FACE1,FOLD,V)
JUMPG 1,[LAC EDGE↔EXCH EJUT↔DAC EDGE↔GO .+1]
;HIDE UNDER EDGES.
CALL(,FACE1,EJUT,JUT)
CALL(EHIDE,FACE2,EDGE,JUT)
CALL(EHIDE)↔POP2J
DECLARE{EJUT,JOT,JUT,FACE1,FACE2,V,FOLD,EDGE}
ENDR MKTJ; BGB 14 FEB 73.-----------------------------------------
SUBR(EHIDE,FACE,EDGE,VERTEX) ;EDGE HIDE.
COMMENT ⊗------------------------------------------------------------
⊗
DEFINE HIDE{LAC 1,EDGE↔MARKZ 1,POTENT}
;INITIALIZATION.
LAC 1,EDGE↔TEST 1,POTENT↔POP3J
LAC 2,FACE↔TEST 2,POTENT↔POP3J
ALT. 1,2↔PED 0,2↔DAC E0↔DAC E
LAC VERTEX↔DAC V1↔SETQ(V2,{OTHER,EDGE,V1})
SKIPE DMODE↔GO[CALL(VERIFY,[ASCII/EHIDE/],[3])↔GO .+1]
;QMASK←(IF V2=NVT(E) THEN 200 ELSE 100).
LACI 200↔LAC 1,EDGE↔NVT 1,1
CAME 1,V2↔LACI 100↔DAC QMASK
;COMPARE EDGE WITH FACE.
L1: CALL(COMPEE,EDGE,E)↔JUMPLE 1,L2 ;DISJOINT.
TDNE 1,QMASK↔GO[HIDE↔CALL(DPYALL)↔POP3J] ;V2 TOUCHING E.
TRNN 1,1↔GO L2 ;CROSSING.
;CROSSING - CONTINUE INTO NEXT FACE OR MAKE A TJOINT.
L4: CALL(OTHER,E,FACE)
TEST 1,POTENT↔GO L5
ALT 0,1↔CAMN 0,EDGE↔POP3J ;DON'T VISIT SAME FACE TWICE.
LAC 0,EDGE↔ALT. 0,1
DAC 1,FACE↔LAC E↔DAC E0
;DISJOINT - CONTINUE ON THIS FACE OR HIDE EDGE.
L2: SETQ(E,{ECCW,E,FACE})
CAME 1,E0↔GO L1↔HIDE
CALL(DPYALL)
CALL(VHIDE,FACE,V2)↔POP3J ;HIDE ALL ITS FRIENDS.
;MAKE A TJOINT.
L5: HIDE↔LAC 2,V2↔PED. 1,2
CALL(EBREAK,EDGE)↔MARK 1,JUTBIT↔PUSH P,1 ;JOINT UNDER T.
CALL(EBREAK,E)↔MARK 1,JOTBIT↔POP P,2 ;JOINT OVER T.
TJOIN. 1,2↔TJOIN. 2,1
LAC 1,V2↔PED 1,1↔MARK 1,POTENT
CALL(DPYALL)↔POP3J
DECLARE{E0,E,V1,V2,QMASK}
ENDR EHIDE;2/14/73(BGB)----------------------------------------------
SUBR(VHIDE,FACE,VERTEX) ;VERTEX HIDE.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{F,V,E,E0}
LAC V,VERTEX
TEST V,POTENT↔POP2J ;EXIT IF VERTEX IS HIDDEN.
;SEE IF WE CAN HIDE THE JOT OF A JUT.
TEST V,JUTBIT↔GO L1
TJOINT V,V ;GET JOT.
CALL(ZDEPTH,FACE,V)↔JUMPE L1 ;NO - JOT IS OVER FACE.
DAC V,VERTEX ;YES - JOT IS UNDER FACE.
;HIDE THE VERTEX.
L1: LAC V,VERTEX↔MARKZ V,POTENT ;HIDE THE VERTEX.
CDR F,FACE↔UFACE. F,V ;FACE HIDES THIS VERTEX.
;DIAGONOSTIC DISPLAY.
SKIPE DMODE↔GO[
CALL(VERIFY,[ASCII/VHIDE/],[2])↔GO .+1]
;HIDE ALL THE POTENT EDGES OF THIS VERTEX.
L2: CDR V,VERTEX↔PED E,V↔DAC E,E0
L3: TESTZ E,POTENT↔GO L4
SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L3↔GO L5
L4: CALL(EHIDE,FACE,E,V)
GO L2
;EXIT OR HIDE THE JUT OF A JOT.
L5: LAC V,VERTEX
TEST V,JOTBIT↔POP2J
TJOINT V,V↔DAC V,VERTEX ;GET JUT.
TEST V,POTENT↔POP2J↔GO L1 ;EXIT IF VERTEX IS HIDDEN.
ENDR VHIDE;2/14/73(BGB)----------------------------------------------
SUBR(COMPEE,EDG1,EDG2) ;COMPARE EDGE-EDGE.
COMMENT ⊗------------------------------------------------------------
-1 EDGES ARE DISJOINT.
0 EDGES E1 AND E2 ARE IDENTICAL.
+441 EDGE CROSS EACH OTHER.
+110 PVT(E1) IS JOINED TO PVT(E2).
+120 PVT(E1) IS JOINED TO NVT(E2).
+210 NVT(E1) IS JOINED TO PVT(E2).
+220 NVT(E1) IS JOINED TO NVT(E2).
⊗
ACCUMULATORS{Q1,Q2,E1,E2,V1,V2,U1,U2}
DEFINE EPSLON<[0.01]>
AOS COMCNT
SETZ 1,↔LAC E1,EDG1↔LAC E2,EDG2
CAMN E1,E2↔POP2J; IDENTITY CASE.
;FETCH ENDPOINTS - TEST TJOINTS TO GET THE JOT.
PVT V1,E1↔NVT V2,E1
PVT U1,E2↔NVT U2,E2
TESTZ V1,JUTBIT↔TJOINT V1,V1
TESTZ V2,JUTBIT↔TJOINT V2,V2
TESTZ U1,JUTBIT↔TJOINT U1,U1
TESTZ U2,JUTBIT↔TJOINT U2,U2
;TEST FOR EDGES ALREADY HAVINGS A VERTEX OR TJOINT IN COMMON.
NIM 1,110↔CAMN V1,U1↔POP2J
NIM 1,120↔CAMN V1,U2↔POP2J
NIM 1,210↔CAMN V2,U1↔POP2J
NIM 1,220↔CAMN V2,U2↔POP2J
;THE SPAN OVERLAPPING TESTS PREVENT NASTY PARALLEL CASES.
;TEST FOR X-SPAN NOT OVERLAPPING.
LO1←←0 ↔ HI1←←1 ↔ LO2←←2 ↔ HI2←←3
LAC LO1,XPP(V1)↔LAC HI1,XPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
LAC LO2,XPP(U1)↔LAC HI2,XPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO L0
;TEST FOR Y-SPAN NOT OVERLAPPING.
LAC LO1,YPP(V1)↔LAC HI1,YPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
LAC LO2,YPP(U1)↔LAC HI2,YPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO[
L0: SETO 1,↔POP2J] ;EXIT EDGES ARE DISJOINT.
;COMPARE E1 AND U1.
L1: SETZ 1,↔LAC Q1,CC(E1)
LAC BB(E1)↔FMPR YPP(U1)↔FADR Q1,0
LAC AA(E1)↔FMPR XPP(U1)↔FADR Q1,0
LACM Q1↔CAMG EPSLON↔TRO 1,10
;COMPARE E1 AND U2.
LAC Q2,CC(E1)
LAC BB(E1)↔FMPR YPP(U2)↔FADR Q2,0
LAC AA(E1)↔FMPR XPP(U2)↔FADR Q2,0
LACM Q2↔CAMG EPSLON↔TRO 1,20
;EXIT WHEN U1 AND U2 ARE CLEAR OF E1 ON THE SAME SIDE.
XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,30↔GO .+2↔SETO 1,↔POP2J]
TRO 1,40 ;E1 CROSSES E2'S LINE.
;COMPARE E2 AND V1.
LAC Q1,CC(E2)
LAC BB(E2)↔FMPR YPP(V1)↔FADR Q1,0
LAC AA(E2)↔FMPR XPP(V1)↔FADR Q1,0
LACM Q1↔CAMG EPSLON↔TRO 1,100
;COMPARE E2 AND V2.
LAC Q2,CC(E2)
LAC BB(E2)↔FMPR YPP(V2)↔FADR Q2,0
LAC AA(E2)↔FMPR XPP(V2)↔FADR Q2,0
LACM Q2↔CAMG EPSLON↔TRO 1,200
;EXIT WHEN V1 AND V2 ARE CLEAR OF E2 ON THE SAME SIDE.
XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,300↔GO .+2↔SETO 1,↔POP2J]
TRO 1,400 ;E2 CROSSES E1'S LINE.
;ELIMINATE COINCIDANT EDGE-VERTEX OCCURENCES BY FUDGING.
TRNE 1,010↔GO[CALL(FUDGE,U1,E1)↔GO L1] ;U1 NEAR E1'S LINE.
TRNE 1,020↔GO[CALL(FUDGE,U2,E1)↔GO L1] ;U2 NEAR E1'S LINE.
TRNE 1,100↔GO[CALL(FUDGE,V1,E2)↔GO L1] ;V1 NEAR E2'S LINE.
TRNE 1,200↔GO[CALL(FUDGE,V2,E2)↔GO L1] ;V2 NEAR E2'S LINE.
;SOLVE FOR CROSSING LOCUS.
L2: DAC 1,AC1
LAC AA(E1)↔FMPR BB(E2)
LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT#
LAC BB(E1)↔FMPR CC(E2)
LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC XCROSS
LAC CC(E1)↔FMPR AA(E2)
LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC YCROSS
LAC XCROSS↔FMPR[3.5]↔DAC XCRUX
LAC YCROSS↔FMPR[3.5]↔DAC YCRUX
LAC 1,AC1↔TRO 1,1↔POP2J
ENDR COMPEE;3/1/73(BGB)----------------------------------------------
DECLARE{XCROSS,YCROSS,ZCROSS,XCRUX,YCRUX}
SUBR(FUDGE,VERTEX,EDGE)
COMMENT ⊗------------------------------------------------------------
Move 2D vertex locus away from the edge alittle.
⊗↔ ACCUMULATORS{V,E}↔SAVAC(11)
SKIPE DMODE↔GO[CALL(VERIFY,[ASCII/FUDGE/],[2])↔GO .+1]
LAC V,VERTEX↔LAC E,EDGE
LAC BB(E)↔FSC -3↔FADRM YPP(V)
LAC AA(E)↔FSC -3↔FADRM XPP(V)
PED E,V↔DAC E,E0↔DAC E,E1
L: CALL(ECOEF↑,E1)
SETQ(E1,{ECCW,E1,VERTEX})
CAME 1,E0↔GO L
GETAC(11)↔POP2J
DECLARE{E0,E1}
ENDR FUDGE;3/1/73(BGB)--------------------------------------------
SUBR(ZDEDGE,EDGE);SOLVE FOR ZDEPTHS AT THE CROSSING(XCROSS,YCROSS).
COMMENT ⊗------------------------------------------------------------
;Z←((Z2-Z1)*(XCROSS-X1)/(X2-X1))+Z1
⊗
ACCUMULATORS{E,V1,V2}
LAC E,EDGE
PVT V1,E↔NVT V2,E
LACM 0,AA(E)↔LACM 1,BB(E)↔CAMGE 1,0↔GO L
;WHEN DX ≥ DY:
LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
LAC 0,XCROSS↔ FSBR 0,XPP(V1)↔FMPR 1,0
LAC 0,XPP(V2)↔FSBR 0,XPP(V1)↔FDVR 1,0
FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
;WHEN DY > DX:
L: LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
LAC 0,YCROSS↔ FSBR 0,YPP(V1)↔FMPR 1,0
LAC 0,YPP(V2)↔FSBR 0,YPP(V1)↔FDVR 1,0
FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
ENDR ZDEDGE;2/10/73--------------------------------------------------
SUBR(EBREAK,EDGE) ;EBREAK(EDGE) IS LIKE ESPLIT.
COMMENT . _________ __________ EBREAK MANDALA
nccw \ / pcw
\ /
+ ⊗ V
+|
| ENEW
-|
⊗ VNEW
+|
| E
-|
- ⊗
/ \
___ncw___/ \___pccw___.
ACCUMULATORS{B,E,V,Q,R,ENEW,VNEW,PV,NV}
;GET ZDEPTH AT CROSSING.
CALL(ZDEDGE,EDGE)
;CREATE A NEW EDGE AND A NEW VERTEX.
CDR E,EDGE↔PVT V,E↔CCW B,E
SETQ(VNEW,{MKV,B})↔MARK VNEW,TMPBIT+POTENT
EXCH 1,TJLIST↔TJ. 1,VNEW ;CONS VNEW TO TJ LIST.
SLACI XCROSS↔LAPI XPP(VNEW)↔BLT ZPP(VNEW)
LAC XCRUX↔XDC. 0,VNEW↔LAC YCRUX↔YDC. 0,VNEW
LAC ZCROSS↔DAC ZPP(VNEW)
SETQ(ENEW,{MKE,B})
;COPY EDGE COEFFICIENTS, TYPE, UFACE & WORD8.
SLACI AA(E)↔LAPI AA(ENEW)↔BLT(ENEW)
LAC 8(E)↔DAC 8(ENEW)
UFACE 0,E↔UFACE. 0,ENEW
;PLACE EDGE AT END OF POTENT EDGE LIST.
LAC 1,WORLD↔NED 2,1↔NED. ENEW,1
NEDR. 2,ENEW↔PEDR. ENEW,2
SKIPN EOWPTR↔GO .+4
DAC ENEW,@EOWPTR↔AOS EOWPTR↔DZM@EOWPTR
;PLACE VNEW BETWEEN E AND ENEW.
PED 0,V↔CAMN 0,E↔PED. ENEW,V
PED. ENEW,VNEW↔PVT PV,E↔PVT. PV,ENEW
PVT. VNEW,E↔NVT. VNEW,ENEW
PFACE 0,E↔PFACE. 0,ENEW
NFACE 0,E↔NFACE. 0,ENEW
;NEW UPPER WINGS ARE LIKE THE OLDE;
PCW 0,E↔CALL(WING,0,ENEW)
NCCW 0,E↔CALL(WING,0,ENEW)
;EDGES POINT AT EACH OTHER ACROSS VNEW.
NCCW. ENEW,E↔PCW. ENEW,E
NCW. E,ENEW↔PCCW. E,ENEW
LAC 1,VNEW↔PFACE 2,ENEW↔TESTZ 2,POTENT↔POP1J
CALL(INVERT↑,ENEW)↔LAC 1,VNEW↔POP1J
ENDR EBREAK;2/10/73(BGB)---------------------------------------------
SUBR(TJSCAN) ;SCAN TJ LIST & PROMULAGATE UNDER FACES.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{UF1,UF2,JUT,JOT,F1,F2,E,E1,E2,V1}
;SCAN THRU TJ-LIST FOR POTENT JUTS.
SKIPA JUT,TJLIST; ⊗V1
L1: TJ JUT,JUT; |
SKIPN JUT↔POP0J; F1 UF1 |E1
TEST JUT,JUTBIT↔GO L1; |
TEST JUT,POTENT↔GO L1; EDGE JUT ⊗JOT
PUSH P,JUT; SAVE. ⊗-------------⊗-|------------⊗
;TJOINT ORIENTATION: |
; PED(JUT) IS POTENT AND F2 UF2 |E2
; PED(JOT) IS OVER PFACE(PED(JUT)). |
; ⊗
;PICKUP ALL THE FRIENDS OF THE PRESENT JUT.
TJOINT JOT,JUT↔PED E1,JOT ;JOT'S EDGES.
SETQ(E2,{ECCW,E1,JOT})
SETQ(V1,{OTHER,E1,JOT})
PED E,JUT↔TESTZ E,POTENT↔GO L4 ;POTENT JUT EDGE.
SETQ(E,{ECCW,E,JUT})↔PED. E,JUT
L4: PFACE F1,E↔TEST F1,POTENT↔DZM F1 ;POTENT JUT FACES.
NFACE F2,E↔TEST F2,POTENT↔DZM F2
;FORCE ORIENTATION AS IN THE MANDALA.
LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V1)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V1)↔FADR 1,0
SKIPG 1↔EXCH E1,E2↔PED. E1,JOT
;TRY TO HIDE THE JUT.
UFACE UF1,E1↔SKIPLE UF1↔CAMN UF1,F1↔GO L2
CALL(ZDEPTH,UF1,JUT)↔JUMPE L2
CALL(LINKED↑,UF1,JUT)↔JUMPN 1,L2
CALL(WITHIN,UF1,JUT)↔GO L2
CALL(VHIDE,UF1,JUT)↔GO L9
L2: UFACE UF2,E2↔SKIPLE UF2↔CAMN UF2,F2↔GO L3
CALL(ZDEPTH,UF2,JUT)↔JUMPE L3
CALL(LINKED↑,UF2,JUT)↔JUMPN 1,L3
CALL(WITHIN,UF2,JUT)↔GO L3
CALL(VHIDE,UF2,JUT)↔GO L9
;PROPAGATE UNDERFACES OF THIS JOT.
L3: CALL(,F2,E2,JOT)
CALL(EPROP,F1,E1,JOT) ;EDGE UNDERFACE PROPAGATION.
CALL(EPROP)
L9: POP P,JUT↔GO L1
ENDR TJSCAN;3/4/73(BGB)-------------------------------------------
SUBR(EPROP,UF,EDGE,VERTEX) ;PROPAGATE UNDER FACE ALONG THE FOLDS.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{A2,A3,E,V,F,JUT,EJ,JOT}
L0: SKIPGE F,UF↔POP3J
LAC E,EDGE↔TEST E,POTENT↔POP3J
LAC V,VERTEX↔TEST V,POTENT↔POP3J
;PLACE UF IN EDGE IF BETTER THAN THE ONE IT MAY HAVE ALREADY.
L1: UFACE 1,E↔CAMN 1,UF↔POP3J ;CONSISTENT.
LAC F,UF↔UFACE. F,E
SKIPN DMODE↔GO L1B ;TRACE DIAGONOSTIC.
DAC F,UF↔DAC E,EDGE↔DAC V,VERTEX
CALL(VERIFY,[ASCII/EPROP/],[3])
LAC F,UF↔LAC E,EDGE↔LAC V,VERTEX
L1B: SETQ(V,{OTHER,E,V})↔UFACE. F,V
TESTZ V,JOTBIT↔GO L3
TESTZ V,JUTBIT↔GO L4
;EXIT WHEN UFACE LINKED TO VERTEX.
JUMPE F,L2-1 ;BGND NEVER LINKED TO VERTEX.
CALL(LINKED↑,F,V)↔JUMPN 1,POP3J.
;PROPAGATE UNDER FACE FROM ONE OPEN FOLD OF A VERTEX TO THE OTHER.
DAC E,1
L2: CALL(ECCW,1,V)↔CAMN 1,E↔POP3J ;EXIT WHEN RING'A'ROUND IS DONE.
TEST 1,FOLDED↔GO L2 ;MUST BE FOLDED TO HAVE AN UNDERFACE.
UFACE A3,1↔DAC 1,A2↔JUMPLE A3,L2B ;UFACE LACKING.
CALL(LINKED,A3,V)↔JUMPN 1,L2 ;UFACE NOT CONNECTED.
L2B: LAC E,A2↔GO L1
;SEE IF WE CAN WIPE THIS JOT'S JUT; OTHERWISE:
;PROPAGATE FAR UNDER FACE THRU TJOINT - JOT TO JUT.
L3: TJOINT JUT,V↔TEST JUT,POTENT↔GO L2-1
PED EJ,JUT↔TESTZ EJ,POTENT↔GO L3B
SETQ(EJ,{ECCW,EJ,JUT})
L3B: PFACE 0,EJ↔CAMN 0,F↔POP3J ;NOTHING NEW.
NFACE 0,EJ↔CAMN 0,F↔POP3J
DAC F,UF↔JUMPE F,L3C ;JUMP WHEN BGND.
DAC E,EDGE↔DAC V,VERTEX
CALL(ZDEPTH,F,JUT)↔JUMPE L3C ;JUMP WHEN JUT VISIBLE.
CALL(WITHIN,F,JUT)↔FATAL({UNDERFACE ESCAPE.})
CALL(VHIDE,F,JUT)↔GO L0
L3C: DAC JUT,VERTEX↔DAC EJ,EDGE↔GO L0
;PROPAGATE FAR UNDER FACE THRU TJOINT - JUT TO JOT.
L4: DAC F,UF↔PED E,V↔PFACE F,E ;JUT'S EDGE.
TEST F,POTENT↔NFACE F,E
TJOINT V,V↔DAC V,VERTEX ;JOT.
PED EJ,V↔CALL(OTHER,EJ,V)
CALL(QFEV,F,E,1)↔JUMPL 1,L4B ;JUMP ALREADY TO NFACE SIDE.
SETQ(EJ,{ECCW,EJ,V})
L4B: DAC EJ,EDGE↔GO L0
ENDR EPROP;3/4/73(BGB)--------------------------------------------
SUBR(VPROP,FACE,VERTEX)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{V,UF,E,E0}
;IGNORE TJOINTS & NON-FOLDED VERTICES & VERTICES WHICH HAVE A UFACE.
LAC V,VERTEX↔TESTZ V,FOLDED+JUTBIT+JOTBIT↔SKIPA↔POP2J
UFACE UF,V↔CAMN UF,FACE↔POP2J ;VERTEX ALREADY HAS THIS UFACE.
LAC UF,FACE↔UFACE. UF,V ;PUT UFACE INTO THE VERTEX.
L0: LAC V,VERTEX ;INIT VERTEX RING'A'ROUND.
PED E,V↔DAC E,E0
;FIND "OPEN" FOLDED EDGES.
L1: TEST E,FOLDED↔GO L3 ;EDGE ISN'T EVEN FOLDED.
UFACE UF,E↔JUMPL UF,L2 ;UFACE LACKING.
CAMN UF,FACE↔GO L3 ;UFACE CONSISTENT.
JUMPE UF,L2
CALL(LINKED↑,UF,VERTEX)↔JUMPN 1,L3;UFACE NOT CONNECTED.
L2: CALL(EPROP,FACE,E,V)
GO L0
;RING-A-AROUND THE VERTEX.
L3: SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L1
POP2J ;EXIT.
ENDR VPROP;7/31/73(BGB)----------------------------------------------
SUBR(SHOW) ;PROPAGATE VISIBLE EDGES.
COMMENT ⊗------------------------------------------------------------
⊗
;MACRO TO REMOVE EDGE FROM POTENT EDGE RING.
DEFINE REMEL{
NEDR 2,1↔PEDR 3,1↔SKIPE 3↔NEDR. 2,3
SKIPE 2↔PEDR. 3,2↔SKIPN 2↔DAC 3,PVEL}
;SHOW THE OBVIOUSLY VISIBLE VERTICES.
CALL(VPROP,BGND,VXMIN)↔CALL(VPROP,BGND,VXMAX)
CALL(VPROP,BGND,VYMIN)↔CALL(VPROP,BGND,VYMAX)
CALL(VSHOW,VXMIN)↔CALL(VSHOW,VXMAX)
CALL(VSHOW,VYMIN)↔CALL(VSHOW,VYMAX)
;SCAN FOR REMAINING POTENT EDGES.
DZM AVEL
L0: SKIPN 1,AVEL↔LAC 1,PVEL ;LAST VISIBLE EDGE.
L1: TESTZ 1,POTENT↔GO L2
DAC 1,AVEL↔PEDR 1,1
JUMPN 1,L1
;MAKE VISIBLE EDGE LIST.
LAC 1,AVEL↔TDCA 2,2 ;SET NEW AVEL TO NIL IN AC-2.
L3: NEDR 1,1↔JUMPE 1,L4 ;"UN"-CDR OLD AVEL FROM AC-1.
TEST 1,VISIBLE↔GO L3
NEDR. 1,2↔PEDR. 2,1 ;HITS AC-6 WHEN AC-2 IS ZERO.
LAC 2,1↔GO L3
L4: DAC 2,AVEL↔ZAC↔NEDR. 0,2
LAC 1,WORLD↔PED. 2,1 ;ACTUALLY VISIBLE EDGE LIST.
;ELIMINATE JOT'S LACKING VISIBLE JUTS.
SKIPA 4,TJLIST
L5: TJ 4,4↔JUMPE 4,[POP0J] ;CDR TJOINT LIST.
TEST 4,JOTBIT↔GO L5↔TJOINT 5,4
TESTZ 5,VISIBLE↔GO L5↔PED 1,4↔REMEL ;REMOVE PED(JOT).
CALL(,4)↔TJ 4,4↔CALL(KLEV↑)↔GO L5+1 ;KILL JOT.
;TRY TO PROMOTE A POTENTIALLY VISIBLE EDGE TO VISIBLE.
L2: PVT 1,1↔DAC 1,VERTEX
CALL(FSCAN,VERTEX)↔GO L0 ;SKIP VISIBLE VERTEX.
CALL(VPROP,1,VERTEX) ;PROPAGATE UNDERFACE OF VERTEX.
CALL(VSHOW,VERTEX)
GO L0
DECLARE{VERTEX}
ENDR SHOW;7/25/73(BGB)-----------------------------------------------
SUBR(VSHOW,VERTEX)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{V,E,E0,F}
LAC V,VERTEX↔TESTZ V,JUTBIT↔TJOINT V,V ;DO JOTS FIRST.
DAC V,VERTEX↔TEST V,POTENT↔GO L4
L1:
SKIPN DMODE↔GO .+4↔CALL(VERIFY,[ASCII/VSHOW/],[1])
LAC V,VERTEX↔LAC(V)↔TLC(POTENT+VISIBLE)↔DAC(V)
TEST V,FOLDED↔GO L2
;CHECK OUT THE UNDERFACE OF THIS VERTEX.
UFACE 1,V↔JUMPGE 1,L2 ;UFACE EXISTS - SO CONTINUE.
CALL(FSCAN,V)↔POP1J ;FIND UNDERFACE AND SKIP.
UFACE. 1,V↔CALL(VPROP,1,V) ;PROPAGATE UNDERFACE JUST FOUND.
;RING'A'ROUND THE VERTEX.
L2: LAC V,VERTEX↔PED E,V↔DAC E,E0 ;INITIALIZE VERTEX GO ROUND.
L3: TESTZ E,POTENT↔GO[
CALL(ESHOW,E,V)↔GO L2]
SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L3
L4: TEST V,JOTBIT↔POP1J
TJOINT 1,V↔DAC 1,VERTEX ;DO JUTS SECOND.
TEST 1,POTENT↔POP1J
L5: UFACE F,V↔JUMPLE F,L1 ;NOT LINKED TO AN UNDERFACE.
CALL(LINKED↑,1,F)↔JUMPN 1,L1
CALL(ZDEPTH,F,VERTEX)↔JUMPE L1 ;JUMP VERTEX IS ABOVE F.
CALL(VHIDE,F,VERTEX)↔POP1J
ENDR VSHOW;7/26/73(BGB)----------------------------------------------
SUBR(ESHOW,EDGE,VERTEX)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{E}
SKIPN DMODE↔GO .+4↔CALL(VERIFY,[ASCII/ESHOW/],[2])
LAC E,EDGE↔TEST E,POTENT↔POP2J
TLC(POTENT+VISIBLE)↔DAC(E)
;(MARK THE FACES AS VISIBLE).
CALL(OTHER,EDGE,VERTEX)
DAC 1,EDGE
POP P,-1(P) ;MOVE RETURN ADDRESS DOWN.
JCALL VSHOW
ENDR ESHOW;7/26/73(BGB)----------------------------------------------
SUBR(FSCAN,VERTEX) ;FACE SCAN FOR UNDERFACE OF V AND SKIP.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{F,V,E,E0}
LAC BGND↔DAC FMAX
SLACI(1B0)↔DAC ZMAX
;FOR ALL THE FACES ON THE LIST OF THE WINDOW CONTAINING THIS VERTEX.
LAC V,VERTEX
LAC F,WORLD↔PFACE F,F↔SKIPA
L1: POTEN F,F↔JUMPN F,.+4↔AOS(P)
LAC 1,FMAX↔POP1J ;UNDERFACE FOUND SKIP EXIT.
CALL(WITHIN,F,V)↔GO L1
;FACE SURROUNDS VERTEX.
CALL(ZDEPTH,F,V)↔JUMPN L2 ;JUMP VERTEX HIDDEN BY F.
CAMGE 1,ZMAX↔GO L1
DAC F,FMAX↔DAC 1,ZMAX ;SAVE NEW UNDERFACE CANDIDATE.
GO L1
;VERTEX HIDDEN BY A FACE - NO SKIP EXIT.
L2: MARK V,POTENT
MARKZ V,VISIBLE
CALL(VHIDE,F,V)
POP1J
DECLARE{FMAX,ZMAX}
ENDR FSCAN;7/24/73(BGB)----------------------------------------------
SUBR(QEV,EDGE,VERTEX) ;DISTANCE VERTEX TO EDGE.
COMMENT ⊗____________________________________________________________
⊗↔ ACCUMULATORS{E,V}
LAC V,VERTEX
LAC E,EDGE
LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
POP2J
ENDR QEV;2/10/73(BGB)________________________________________________
SUBR(QFEV,FACE,EDGE,VERTEX) ;DIRECTED DISTANCE VERTEX TO EDGE.
COMMENT ⊗____________________________________________________________
⊗↔ ACCUMULATORS{E,V}
LAC V,VERTEX
LAC E,EDGE
LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,FACE↔MOVNS 1
POP3J
ENDR QFEV;2/10/73(BGB)_______________________________________________
SUBR(CROSSING,X,Y,EDGE1,EDGE2)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{TT,XPTR,YPTR,E1,E2}
LAC E1,EDGE1↔LAC E2,EDGE2
LAC AA(E1)↔FMPR BB(E2)
LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT
LAC BB(E1)↔FMPR CC(E2)
LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC@X
LAC CC(E1)↔FMPR AA(E2)
LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC@Y
POP4J
ENDR CROSSING;2/10/73(BGB)-------------------------------------------
SUBR(ZDEPTH,FACE,VERTEX) ;ZPP DEPTH.
COMMENT ⊗____________________________________________________________
Return AC0 =-1 when vertex is under the face.
Return AC0 = 0 when vertex is above the face.
Return AC1 = ZPP depth = (KK-AA*Xpp-BB*Ypp)/CC. ⊗
ACCUMULATORS{F,V}
EXCH V,VERTEX↔EXCH F,FACE ;GET ARGS & SAVE ACS.
LAC 1,KK(F)
LAC AA(F)↔FMPR XPP(V)↔FSBR 1,0
LAC BB(F)↔FMPR YPP(V)↔FSBR 1,0
FDVR 1,CC(F)
SETO↔CAMG 1,ZPP(V)↔SETZ ;ZPP-OVER > ZPP-UNDER.
EXCH V,VERTEX↔EXCH F,FACE ;RESTORE ACCUMULATORS.
POP2J
ENDR ZDEPTH;2/10/73(BGB)---------------------------------------------
SUBR(ZDALT,FACE,X,Y)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{F}
LAC F,FACE↔LAC 1,KK(F)
LAC AA(F)↔FMPR X↔FSBR 1,0
LAC BB(F)↔FMPR Y↔FSBR 1,0
FDVR 1,CC(F)↔POP3J
ENDR ZDALT;2/10/73(BGB)----------------------------------------------
SUBR(WITHIN,FACE,VERTEX)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{F,V,E,E0}
SAVAC(5)
LAC F,FACE
LAC V,VERTEX
PED E,F↔DAC E,E0
L1: LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,F↔MOVNS 1
L2: JUMPLE 1,L3 ;VERTEX OUTSIDE FACE.
SETQ(E,{ECCW,E,F})
CAME E,E0↔GO L1↔CALL(LINKED↑,F,V)
JUMPN 1,L3 ;NO SKIP - VERTEX IS PART OF THIS FACE.
AOS(P) ;SKIP VERTEX WITHIN FACE.
L3: GETAC(5)
POP2J
ENDR WITHIN;2/27/73(BGB)---------------------------------------------
SUBR(KLJOTS,WORLD)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,V}
CDR B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: NVT V,V↔CAMN V,B↔GO L1
TEST V,TMPBIT↔GO L2
TEST V,JOTBIT↔GO L2
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L2+1
ENDR KLJOTS;2/16/73(BGB)---------------------------------------------
SUBR(KLJUTS,WORLD)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,V}
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: NVT V,V
TEST V,VBIT↔GO L1
TEST V,TMPBIT↔GO L2
TEST V,JUTBIT↔GO L2
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L2+1
ENDR KLJUTS;2/16/73(BGB)---------------------------------------------
SUBR(KLTMPS,WORLD) ; KILL ALL THE TMP VERTICES IN THE WORLD.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,V,E}
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
LAC E,B
L2: NED E,E↔CAMN E,B↔GO L3-1
TEST E,TMPBIT↔GO L2
NED E,E↔PUSH P,E↔PUSH P,B
PED E,E↔CALL(KLFE,E)
POP P,B↔POP P,E↔GO L2+1
LAC V,B
L3: NVT V,V↔CAMN V,B↔GO L1
TEST V,TMPBIT↔GO L3
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L3+1
ENDR KLTMPS;3/16/73(BGB)------------------------------------------
EXTERN IDPY,EDPY,VDPY
EXTERN DPYSET,DPYBUF,DPYOUT,DPYBRT,DPYBIG,BUFDPY
EXTERN AIVECT,AVECT,FLODPY,DECDPY,DPYSTR,DTYO
SUBR(VERIFY)NAME,ARGCNT ;DIAGONOSTIC DISPLAY.
COMMENT ⊗------------------------------------------------------------
⊗
CALL(DPYSET,DPYBUF)↔AOS STEP
CALL(AIVECT,[-=510],[-=220])↔CALL(DPYBIG,[4])
CALL(DECDPY,STEP)↔CALL(DPYSTR,{[[ASCIZ/. /]]})
LAC ARG2↔DAC NAME↔CALL(DPYSTR,[NAME])
;GET POINTER TO HIS ARGUMENTS.
LACI 16,-3(17) ;STACK POINTER TO HIS RETURN ADR.
LAC ARG1↔SUB 16,0
MOVNS↔DIP 0,16 ;AOBJN POINTER.
DAC 16,SAV#
JUMPE 0,L3 ;HE'S GOT NO ARGUMENTS.
;DISPLAY ARGUMENT LIST.
PUSH P,["("]↔SKIPA
L0: CALL(DTYO,{[","]})↔CDR 1,(16)↔CALL(IDPY,1)↔AOBJN 16,L0
CALL(DTYO,{[")"]})
LAC 16,SAV
L1: CDR 1,(16)↔JUMPE 1,L2 ;GET AN ARGUMENT.
LAC 0,(1) ;GET ITS TYPE BITS.
TLNE(FBIT)↔GO[CALL(FDPY,1)↔GO L2]
TLNE(EBIT)↔GO[CALL(EDPY,1)↔GO L2]
TLNE(VBIT)↔GO[CALL(VDPY,1)↔GO L2]
L2: AOBJN 16,L1
L3: CALL(DPYBIG,[2])↔CALL(DPYOUT,[16])
SETZ↔SKIPE RUNFLG↔GO L4
;NOT RUNNING - SINGLE STEP VERIFICATION.
INCHRW
CAIN 175↔SETOM RUNFLG
CAIL"0"↔CAILE"9"↔POP2J
ANDI 17↔LAC 1,STEP2
IMULI 1,=10↔ADD 1↔DAC STEP2
GO L3
;RUNNING UNTIL STEP2 OR CHR.
L4: SKIPE 1,STEP2↔CAMLE 1,STEP↔GO .+4
DZM STEP2↔DZM RUNFLG↔GO L3
INCHRS↔POP2J↔DZM RUNFLG↔GO L3
NAME:0↔0
DECLARE{RUNFLG,STEP,STEP2}
ENDR;2/24/73------------------------------------------------------
FDPY:;------------------------------------------------------------
BEGIN FDPY
LAC 1,ARG1↔DAC 1,F
PED 1,1↔DAC 1,E0↔DAC 1,E
CALL(DPYBRT,[3])
CALL(VCW,E,F)
XDC 0,1↔FIXX↔YDC 1,1↔FIXX 1,↔CALL(AIVECT,0,1)
L: CALL(VCCW,E,F)
XDC 0,1↔FIXX↔YDC 1,1↔FIXX 1,↔CALL(AVECT,0,1)
SETQ(E,{ECCW,E,F})
CAME 1,E0↔GO L↔CALL(DPYBRT,[2])↔POP1J
DECLARE{F,E,E0}
BEND;2/10/73------------------------------------------------------
DPYALL:;----------------------------------------------------------
BEGIN DPYALL
EXTERN AIVECT,AVECT
SKIPN DMODE↔POP0J
CALL(DPYSET,DPYBUF)
LAC 1,WORLD↔DAC 1,B
L1: LAC 1,B#↔CCW 1,1↔DAC 1,B
TEST 1,BBIT↔GO[CALL(DPYOUT,[1])↔POP0J]
DAC 1,E#↔DZM CNT#
L2: LAC 1,E↔PED 1,1↔DAC 1,E↔AOS CNT
TEST 1,EBIT↔GO L1
TEST 1,POTENT↔GO L2
PVT 2,1↔NVT 3,1
XDC 0,3↔FIXX↔PUSH P,
YDC 0,3↔FIXX↔PUSH P,
XDC 0,2↔FIXX↔PUSH P,
YDC 0,2↔FIXX↔PUSH P,
CALL(AIVECT)
CALL(AVECT)
GO L2
BEND;2/10/73------------------------------------------------------
SUBR(WINDPY,S00) ;WINDOW DISPLAY.
COMMENT ⊗------------------------------------------------------------
⊗↔ E←←S0←←12↔XL←←13↔XH←←14↔YL←←15↔YH←←16
CALL(DPYSET,DPYBUF)↔LAC 1,S00
SLACI -4(1)↔LAPI XL↔BLT YH
FMP XL,[3.5]↔FIXX XL,↔FMP YL,[3.5]↔FIXX YL,
FMP XH,[3.5]↔FIXX XH,↔FMP YH,[3.5]↔FIXX YH,
CALL(AIVECT,XL,YL)
CALL(AVECT,XH,YL)↔CALL(AVECT,XH,YH)
CALL(AVECT,XL,YH)↔CALL(AVECT,XL,YL)
CALL(DPYOUT,[14])↔CALL(DPYBRT,[5])
LAC S0,ARG1↔LACN -5(S0)↔DIP S0
SKIPE↔GO[LAC 1,(S0)↔PVT 2,1↔NVT 1,1
XDC XL,1↔YDC YL,1↔XDC XH,2↔YDC YH,2
FIXX XL,↔FIXX YL,↔FIXX XH,↔FIXX YH,
CALL(AIVECT,XL,YL)↔CALL(AVECT,XH,YH)
AOBJN S0,.↔GO .+1]
LAC 1,ARG1↔LAC E,-6(1)
L1: POTEN E,E↔JUMPE E,POP1J.
TEST E,POTENT↔GO L1
CALL(EDPY,E)↔GO L1
POP1J
ENDR WINDPY;---------------------------------------------------------
SUBR(STAT) ;DISPLAY OCCULT STATISTICS.
COMMENT ⊗------------------------------------------------------------
⊗
CALL(DPYSET,BUFDPY)
SETZ↔MSTIME↔SUB TIME1↔MOVM↔FLOAT↔SKIPN↔MOVSI(0.5)↔FDVRI(1000.0)↔DAC TIME1
SETZ↔RUNTIM↔SUB TIME2↔MOVM↔FLOAT↔SKIPN↔MOVSI(0.5)↔FDVRI(1000.0)↔DAC TIME2
FDVR TIME1↔FMPR[100.0]↔FIXX↔DAC RATIO#
CALL(DPYBIG,[1])
CALL(AIVECT,[0],{[656]})
CALL(DPYSTR,{[[ASCIZ/REAL TIME /]]})
CALL(FLODPY,TIME1,[2])
CALL(AIVECT,[0],{[632]})
CALL(DPYSTR,{[[ASCIZ/RUN TIME /]]})
CALL(FLODPY,TIME2,[2])
CALL(AIVECT,[0],{[609]})
CALL(DPYSTR,{[[ASCIZ/TIME SHARE /]]})
CALL(DECDPY,RATIO)
CALL(DTYO,["%"])
CALL(AIVECT,[0],[-620])
CALL(DPYSTR,{[[ASCIZ/PDLTOP /]]})↔CALL(DECDPY,PDLTOP)
CALL(DPYSTR,{[[ASCIZ/ WINDOWS /]]})↔CALL(DECDPY,WNDCNT)
CALL(DPYSTR,{[[ASCIZ/ COMPARES /]]})↔CALL(DECDPY,COMCNT)
CALL(DPYBIG,[2])
CALL(DPYOUT,[16])
SKIPN DMODE↔POP0J
CALL(DPYSET,DPYBUF)
CALL(DPYOUT,[15])
CALL(DPYOUT,[14])
POP0J
ENDR STAT;3/4/73(BGB)------------------------------------------------
END
OCCULT.FAI - EOF.